home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / dbase / lib19.zip / WINDOWS.PRG < prev   
Text File  |  1992-10-09  |  47KB  |  1,293 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: WINDOWS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/19/1992
  5. *-- Notes.....: This set of functions was published in the JUNE, 1992 issue of
  6. *--             Technotes for dBASE IV (Vol. 90). The routines were created
  7. *--             by Adam Menkes, except for the ones added in (used by a couple
  8. *--             of the functions) that were written by Jay Parsons (JPARSONS).
  9. *--             For a complete explanation on how these routines work, you need
  10. *--             to read the article in TechNotes. I have entered the routines,
  11. *--             and added the standard DUFLP notation at the beginning, and 
  12. *--             once this issue of TN has been posted on the BORBBS, this file
  13. *--             will be added to the 'current' version of LIBxx.ZIP.
  14. *-------------------------------------------------------------------------------
  15.  
  16. FUNCTION Alert
  17. *-------------------------------------------------------------------------------
  18. *-- Programmer..: Adam L. Menkes (SUPREME1)
  19. *-- Date........: 06/01/1992
  20. *-- Notes.......: This routine creates a popup on the screen with a title and
  21. *--               one line message, forcing the user to notice the message.
  22. *--               The user must use the mouse on the 'OK' pad, press <Esc> or
  23. *--               press <Enter> to move on in the program that called this
  24. *--               function.
  25. *-- Written for.: dBASE IV, 1.5
  26. *-- Rev. History: 06/19/1992 - Modified to accept the <Enter> key by Ken Mayer,
  27. *--               also a bit better cleanup at the end (releasing things from
  28. *--               memory, and so on).
  29. *-- Calls.......: None
  30. *-- Called by...: Any
  31. *-- Usage.......: Alert("<cTitle>","<cMessage>")
  32. *-- Example.....: lX = Alert("Print Aborted","You pressed <ESC>")
  33. *-- Returns.....: Logical
  34. *-- Parameters..: cTitle   = Title line
  35. *--               cMessage = One line message (up to 79 characters)
  36. *-------------------------------------------------------------------------------
  37.  
  38.     parameters cTitle, cMessage
  39.     private wWindow,nRow,nCol,mPad
  40.     
  41.     wWindow = WINDOW()                  && save current Window
  42.     save screen to sTemp                && save the screen
  43.     activate screen
  44.     
  45.     nRow = iif(val(right(set("DISPLAY"),2)) = 43,18,8)  && center from top-bottom
  46.     nCol = 38 - (max(len(cTitle),len(cMessage))/2)      && center left-right
  47.     nCol2 = max(len(cTitle),len(cMessage))  && right side?
  48.     
  49.     *-- clear out a section of the screen
  50.     @nRow,nCol Clear to nRow+6,nCol+nCol2
  51.     *-- fill in a box
  52.     @nRow,nCol Fill  to nRow+6,nCol+nCol2+1 color n+  && grey
  53.     *-- put a double line border around box
  54.     @nRow,nCol to nRow+6,nCol+nCol2+1 double color bg+
  55.     *-- display title
  56.     @nRow + 1,nCol + 1 + iif(len(cTitle) > len(cMessage),0,;
  57.        (len(cMessage)-len(cTitle)) / 2) say cTitle color w+/n
  58.     *-- display line 
  59.     @nRow + 2, nCol + 1 to nRow + 2, nCol + nCol2 color bg+
  60.     *-- display message
  61.     @nRow + 3, nCol+1+iif(len(cTitle) > len(cMessage),;
  62.         (len(cTitle)-len(cMessage)) / 2, 0) say cMessage color w+/n
  63.     
  64.     *-- define/display a very small menu (one pad)
  65.     define menu mAlert
  66.     define pad pPad1 of mAlert prompt " OK " at nRow +5,37
  67.     on selection pad pPad1 of mAlert deactivate menu
  68.     
  69.     *-- added by Ken to deal with <Enter>
  70.     on key label ctrl-M keyboard "{27}"
  71.     
  72.     *-- start it up
  73.     activate menu mAlert
  74.     
  75.     *-- deal with user 'input'
  76.     mPad = pad()
  77.     
  78.     *-- restore environment, free up RAM by releasing things
  79.     on key label ctrl-m
  80.     restore screen from sTemp
  81.     release screen sTemp
  82.     release menu mAlert
  83.     if "" # wWindow
  84.         activate window &wWindow
  85.     endif
  86.     
  87. RETURN .not. "" = mPad  && not empty pad?
  88. *-- EoF: Alert()
  89.  
  90. FUNCTION CheckBox
  91. *-------------------------------------------------------------------------------
  92. *-- Programmer..: Adam L. Menkes (SUPREME1)
  93. *-- Date........: 06/01/1992
  94. *-- Notes.......: This routine brings up a one-line message, allows the user
  95. *--               to click mouse/press <Space> on it, to change status.
  96. *--               Pressing <Enter>/<Esc> chooses the current setting ...
  97. *-- Written for.: dBASE IV, 1.5
  98. *-- Rev. History: None
  99. *-- Calls.......: None
  100. *-- Called by...: Any
  101. *-- Usage.......: CheckBox(<lVar>,"<cTitle>",<nRow>,<nCol>,<nASCII>)
  102. *-- Example.....: lX = CheckBox(.t.,"OK as is?",9,10,4)
  103. *-- Returns.....: Logical
  104. *-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
  105. *--               cTitle   = Title/Message
  106. *--               nRow     = Row to place this
  107. *--               nCol     = Column ...
  108. *--               nASCII   = ascii character to use in box. (Optional)
  109. *--                          Default is 251 (√). Other suggestions include:
  110. *--                          4 (diamond), 176 (░), 177 (▒), 178 (▓),
  111. *--                          219 (█), 249 (∙), 250 (·), 254 (■)
  112. *--                          (Check out the ASCII chart in the language ref.)
  113. *-------------------------------------------------------------------------------
  114.  
  115.     parameters lVar, cTitle, nRow, nCol, nASCII
  116.     
  117.     *-- if parameter is left blank, assign 251 (√)
  118.     nASCII = iif(pCount() = 5, nASCII, 251)
  119.     
  120.     define menu mCheck
  121.     
  122.     *-- loop until user does something, or presses <Esc>
  123.     do while .t.
  124.     
  125.         *-- define the menu pad ...
  126.         define pad pCheck1 of mCheck at nRow,nCol prompt;
  127.             "["+iif(lVar,chr(nASCII)," ")+"] "+cTitle
  128.         on selection pad pCheck1 of mCheck deactivate menu
  129.         
  130.         *-- when user presses <Enter> turn it all off ... (send <Esc> ...)
  131.         on key label ctrl-m keyboard "{27}"
  132.         
  133.         *-- start 'er up
  134.         activate menu mCheck
  135.         
  136.         *-- (<Esc> or <Enter>)
  137.         if lastkey() = 27
  138.             exit
  139.         endif
  140.         
  141.         lVar = .not. lVar   && set to opposite of current setting
  142.         
  143.     enddo
  144.     
  145.     *-- reset environment/release things
  146.     on key label ctrl-m
  147.     release menu mCheck
  148.  
  149. RETURN lVar
  150. *-- EoF: CheckBox()
  151.  
  152. Function CheckBx1
  153. *-------------------------------------------------------------------------------
  154. *-- Programmer..: Adam L. Menkes (SUPREME1)
  155. *-- Date........: 06/01/1992
  156. *-- Notes.......: This routine brings up a one-line message, allows the user
  157. *--               to click mouse/press <Space> on it, to change status.
  158. *--               Pressing <Enter>/<Esc> chooses the current setting ...
  159. *--               This one is different, in that it does not use a menu to
  160. *--               accomplish it's ends, but uses instead a memvar, with 
  161. *--               @/GET/READ and a picture using the multiple choice ("@M")
  162. *--               function.
  163. *-- Written for.: dBASE IV, 1.5
  164. *-- Rev. History: None
  165. *-- Calls.......: None
  166. *-- Called by...: Any
  167. *-- Usage.......: CheckBx1(<lVar>,"<cTitle>",<nRow>,<nCol>)
  168. *-- Example.....: lX = CheckBx1(.t.,"OK as is?",9,10)
  169. *-- Returns.....: Logical
  170. *-- Parameters..: lVar     = On or Off to start? (.t.=on, .f.=off)
  171. *--               cTitle   = Title/Message
  172. *--               nRow     = Row to place this
  173. *--               nCol     = Column ...
  174. *-------------------------------------------------------------------------------
  175.  
  176.     parameters lVar, cTitle, nRow, nCol
  177.     
  178.     *-- save parts of environment ...
  179.     cFormat = set("FORMAT")
  180.     set format to
  181.     cCursor = set("CURSOR")
  182.     set cursor off
  183.     
  184.     *-- define starting value of cVar ... 
  185.     *-- (this is ASCII 255, √, ASCII 255, if lVar = .t., 3 spaces if lVar = .f.)
  186.     cVar = iif(lVar,chr(255)+chr(251)+chr(255),space(3))
  187.     
  188.     *-- display/get, using picture
  189.     @nRow,nCol get cVar picture "@M , √ "
  190.     *-- this picture is: space, comma, chr(255), chr(251), chr(255).
  191.     @nRow,nCol + 4 say cTitle
  192.     
  193.     READ
  194.     
  195.     *-- reset environment
  196.     set format to &cFormat
  197.     set cursor &cCursor
  198.     
  199. RETURN .not. (cVar = chr(32))   && not a space
  200. *-- EoF: CheckBx1()
  201.  
  202. FUNCTION DropDown
  203. *-------------------------------------------------------------------------------
  204. *-- Programmer..: Adam L. Menkes (SUPREME1)
  205. *-- Date........: 06/01/1992
  206. *-- Notes.......: This function performs a picklist of a different sort.
  207. *--               In order to use it, you will either use an ARRAY (one-dim)
  208. *--               or a field in a database. It holds a choice in a 'holding 
  209. *--